﻿Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Collections.Generic
Imports Microsoft.VisualBasic

Public Module InfoBox

   Public Enum [Icon]
      None
      Info
      [Error]
      Warning
      Banned
   End Enum

   Public Enum AnchorPoint
      TopLeft
      TopCenter
      TopRight
      BottonLeft
      BottomCenter
      BottomRight
      LeftVerticalCenter
      RightVerticalCenter
   End Enum

   Private Const MaxMessageWidth As Int32 = 300
   Private Const MaxMessageHeight As Int32 = 100

   Public Sub Show(ByVal Prompt As String, _
                   ByVal ControlToDisplayFor As Control, _
                   Optional ByVal Title As String = "", _
                   Optional ByVal Buttons As System.Windows.Forms.MessageBoxButtons = MessageBoxButtons.OK, _
                   Optional ByVal [Icon] As InfoBox.Icon = Icon.None, _
                   Optional ByVal PositionOnControlAnchor As AnchorPoint = AnchorPoint.RightVerticalCenter, _
                   Optional ByVal MessageAnchoringPoint As AnchorPoint = AnchorPoint.TopLeft, _
                   Optional ByVal NoBeep As Boolean = False)

      ' Argument check AnchorPoints
      If Not [Enum].IsDefined(GetType(AnchorPoint), PositionOnControlAnchor) Then
         Throw New ArgumentOutOfRangeException("Invalid PositionOnControlAnchor")
      End If
      If Not [Enum].IsDefined(GetType(AnchorPoint), MessageAnchoringPoint) Then
         Throw New ArgumentOutOfRangeException("Invalid MessageAnchoringPoint")
      End If


      Const flppad As Int32 = 5

      Dim frmInfo As New Form With {.Text = Title, _
                                    .Font = System.Drawing.SystemFonts.MessageBoxFont, _
                                    .FormBorderStyle = FormBorderStyle.FixedDialog, _
                                    .ControlBox = False}


      Dim flpMain As New FlowLayoutPanel With {.FlowDirection = FlowDirection.TopDown, _
                                               .Dock = DockStyle.Fill, _
                                               .Padding = New Padding(flppad), _
                                               .Parent = frmInfo}

      Dim flpMessage As New FlowLayoutPanel With {.FlowDirection = FlowDirection.LeftToRight, _
                                                  .Margin = Padding.Empty, _
                                                  .Parent = flpMain}

      Dim flpButtonsRow As New FlowLayoutPanel With {.FlowDirection = FlowDirection.LeftToRight, _
                                                     .Margin = Padding.Empty, _
                                                     .Parent = flpMain}

      ' The buttons will be place flowlayoutpanel that will be placed in a panel.
      ' This will be docked in flpButtonsRow and flpButtons will be center in the panel
      Dim pnlButtonsflp As New Panel With {.Parent = flpButtonsRow}

      Dim flpButtons As New FlowLayoutPanel With {.FlowDirection = FlowDirection.LeftToRight, _
                                                  .Parent = pnlButtonsflp, _
                                                  .BackColor = SystemColors.Control}


      ' *******************
      ' flpMessage Contents

         Const pbDim As Int32 = 30

         If [Icon] <> InfoBox.Icon.None Then
            Dim pb As New PictureBox With {.Size = New Size(pbDim, pbDim), _
                                           .SizeMode = PictureBoxSizeMode.Zoom, _
                                           .BorderStyle = BorderStyle.None, _
                                           .Parent = flpMessage}

            Dim ico As System.Drawing.Icon = Nothing
            Select Case [Icon]
               Case InfoBox.Icon.Banned
                  ico = My.Resources.banned

               Case InfoBox.Icon.Error
                  ico = My.Resources.Err

               Case InfoBox.Icon.Info
                  ico = My.Resources.info

               Case InfoBox.Icon.Warning
                  ico = My.Resources.warning

            End Select
            pb.Image = ico.ToBitmap

         End If '[Icon] <> InfoBox.Icon.None

         ' Use a label to hold to size the Prompt
         'Dim lblPrompt As New Label With {.text = Prompt, _
         '                                 .Font = SystemFonts.MessageBoxFont, _
         '                                 .Parent = flpMessage, _
         '                                 .AutoSize = True}

         Dim txtSize As Size = System.Windows.Forms.TextRenderer.MeasureText(Prompt, System.Drawing.SystemFonts.MessageBoxFont)
         Dim sb As System.Windows.Forms.ScrollBars = ScrollBars.None


         Dim widthchanged As Boolean
         Dim heightchanged As Boolean
         Dim FinalSize As Size = txtSize
         Do
            If txtSize.Width > MaxMessageWidth And _
               FinalSize.Width <> MaxMessageWidth Then

               FinalSize.Width = MaxMessageWidth
               sb = sb Or ScrollBars.Horizontal
               txtSize.Height += SystemInformation.HorizontalScrollBarHeight
               heightchanged = True

            Else
               heightchanged = False
            End If

            If txtSize.Height > MaxMessageHeight And _
               FinalSize.Height <> MaxMessageHeight Then

               FinalSize.Height = MaxMessageHeight
               sb = sb Or ScrollBars.Vertical
               txtSize.Width += SystemInformation.VerticalScrollBarWidth
               widthchanged = True
            Else
               widthchanged = False
            End If

         Loop Until Not (widthchanged Or heightchanged)

         Dim tbPrompt As New TextBox With {.ReadOnly = True, _
                                           .ScrollBars = sb, _
                                           .Size = FinalSize, _
                                           .Text = Prompt, _
                                           .SelectionStart = 0, _
                                           .SelectionLength = 0, _
                                           .Multiline = True, _
                                           .WordWrap = False, _
                                           .Margin = Padding.Empty, _
                                           .Font = System.Drawing.SystemFonts.MessageBoxFont, _
                                           .BorderStyle = BorderStyle.None, _
                                           .Parent = flpMessage}

         AddHandler tbPrompt.Enter, AddressOf TBEnter
         AddHandler tbPrompt.Leave, AddressOf TBLeave


      ' End flpMessage Contents
      ' ***********************

      ' *******************
      ' flpButtons Contents
         Dim eventedbuttons As New List(Of Button)

         ' save reference so that event handlers can be released on form closing
         frmInfo.Tag = eventedbuttons
         AddHandler frmInfo.FormClosing, AddressOf FormClosing

         Select Case Buttons
            Case MessageBoxButtons.OK
               CreateButton("&Ok", flpButtons, eventedbuttons, DialogResult.OK)

            Case MessageBoxButtons.OKCancel
               CreateButton("&Ok", flpButtons, eventedbuttons, DialogResult.OK)
               CreateButton("&Cancel", flpButtons, eventedbuttons, DialogResult.Cancel)


            Case MessageBoxButtons.YesNo
               CreateButton("&Yes", flpButtons, eventedbuttons, DialogResult.Yes)
               CreateButton("&No", flpButtons, eventedbuttons, DialogResult.No)

            Case MessageBoxButtons.YesNoCancel
               CreateButton("&Yes", flpButtons, eventedbuttons, DialogResult.Yes)
               CreateButton("&No", flpButtons, eventedbuttons, DialogResult.No)
               CreateButton("&Cancel", flpButtons, eventedbuttons, DialogResult.Cancel)

            Case MessageBoxButtons.RetryCancel
               CreateButton("&Retry", flpButtons, eventedbuttons, DialogResult.Retry)
               CreateButton("&Cancel", flpButtons, eventedbuttons, DialogResult.Cancel)

         End Select 'Case Buttons


      ' End flpButtons Contents
      ' ***********************

      'determine required sizings
         'lblPrompt.AutoSize = False
         'lblPrompt.Size = lblPrompt.GetPreferredSize(Size.Empty)

         'Dim rect As Rectangle = New Rectangle(Point.Empty, _
         '                                    New Size( _
         '                                    lblPrompt.ClientRectangle.Width + SystemInformation.VerticalScrollBarWidth, _
         '                                    lblPrompt.ClientRectangle.Height + SystemInformation.HorizontalScrollBarHeight))

         ''rect.Inflate(SystemInformation.VerticalScrollBarWidth, SystemInformation.HorizontalScrollBarHeight)
         'lblPrompt.Size = New Size(rect.Width, rect.Height)

         Dim flpMessageprefsize As Size = flpMessage.GetPreferredSize(Size.Empty)
         Dim flpButtonsprefsize As Size = flpButtons.GetPreferredSize(Size.Empty)

         Dim height As Int32 = flpMessageprefsize.Height + (flpMessage.Margin.Top + flpMessage.Margin.Bottom) + _
                               flpButtonsprefsize.Height + flpButtonsRow.Margin.Bottom


         Dim width As Int32 = Math.Max(flpMessageprefsize.Width, flpButtonsprefsize.Width)
         Dim spacing As Int32 = 2% * flppad

         frmInfo.ClientSize = New Size(width + spacing, height + spacing)

         flpMessage.Size = New Size(width, flpMessageprefsize.Height)
         flpButtonsRow.Size = New Size(width, flpButtonsprefsize.Height)
         pnlButtonsflp.Size = flpButtonsRow.Size

         'compute the location so as to center flpButtons
         Dim flpButtonsMarginSpace As Int32 = width - flpButtonsprefsize.Width
         flpButtons.Location = New Point(flpButtonsMarginSpace \ 2, 0)
         flpButtons.Size = flpButtonsprefsize

      ' compute display position


         frmInfo.StartPosition = FormStartPosition.Manual

         Dim controlTopLeft As Point = ControlToDisplayFor.PointToScreen(Point.Empty)
         Dim controloffset As Size = GetAnchorOffset(PositionOnControlAnchor, ControlToDisplayFor)
         Dim formoffset As Size = GetAnchorOffset(MessageAnchoringPoint, frmInfo)
         Dim proposedloc As Point = Point.Subtract(Point.Add(controlTopLeft, controloffset), formoffset)

         ' ensure that at least the title bar is on screen
            ' get the screen workingarea we are contrained to
            Dim workarea As Rectangle = Screen.FromControl(ControlToDisplayFor).WorkingArea


            ' check the top

            If proposedloc.Y < workarea.Top Then
               proposedloc.Y = workarea.Top
            End If

            ' check the left side
            If proposedloc.X - frmInfo.Width < workarea.Left AndAlso _
               proposedloc.X < workarea.Left - frmInfo.Width Then
               proposedloc.X = workarea.Left - frmInfo.Width
            End If

            'check the right side
            If proposedloc.X + frmInfo.Width > workarea.Right AndAlso _
                proposedloc.X > workarea.Right - frmInfo.Width Then
               ' make at least half of it on screen so the user can grab it
               proposedloc.X = workarea.Right - frmInfo.Width
            End If

            ' check the bottom
            Dim bottomlimit As Int32 = workarea.Bottom - (frmInfo.Height - frmInfo.ClientSize.Height)
            If proposedloc.Y > bottomlimit Then
               proposedloc.Y = bottomlimit
            End If

            frmInfo.Location = proposedloc

      If Not NoBeep Then Beep()

      For i As Int32 = 0 To flpButtons.Controls.Count - 1
         If TypeOf flpButtons.Controls(i) Is Button Then
            frmInfo.ActiveControl = flpButtons.Controls(i)
            Exit For
         End If
      Next

      frmInfo.ShowDialog()

   End Sub

   Private Sub CreateButton(ByVal Text As String, ByVal Parent As Control, ByVal eventedlist As List(Of Button), ByVal tag As DialogResult)
      Dim btn As New Button With {.Text = Text, _
                                  .AutoSize = True, _
                                  .Parent = Parent, _
                                  .Tag = tag}

      eventedlist.Add(btn)
      AddHandler btn.Click, AddressOf btn_Click
   End Sub


   Private Sub btn_Click(ByVal sender As Object, ByVal e As System.EventArgs)
      Dim btn As Button = CType(sender, Button)
      Dim frm As Form = btn.FindForm
      frm.DialogResult = CType(btn.Tag, DialogResult)
      frm.Close()
   End Sub

   Private Sub FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs)
      ' release all event handlers
      Dim frm As Form = CType(sender, Form)
      RemoveHandler frm.FormClosing, AddressOf FormClosing
      Dim eventedbuttons As List(Of Button) = CType(frm.Tag, Global.System.Collections.Generic.List(Of Global.System.Windows.Forms.Button))
      For Each btn As Button In eventedbuttons
         RemoveHandler btn.Click, AddressOf btn_Click
      Next
   End Sub

   Private Function GetAnchorOffset(ByVal SelectedAnchor As AnchorPoint, ByVal cntrl As Control) As Size
         Dim ret As Size

         Select Case SelectedAnchor
            Case AnchorPoint.TopLeft
               ret = Size.Empty

            Case AnchorPoint.TopCenter
               ret = New Size((cntrl.Width \ 2%), 0)

            Case AnchorPoint.TopRight
               ret = New Size(0 + cntrl.Width, 0)

            Case AnchorPoint.LeftVerticalCenter
               ret = New Size(0, cntrl.Height \ 2%)

            Case AnchorPoint.RightVerticalCenter
               ret = New Size(cntrl.Width, cntrl.Height \ 2%)

            Case AnchorPoint.BottonLeft
               ret = New Size(0, cntrl.Height)

            Case AnchorPoint.BottomCenter
               ret = New Size((cntrl.Width \ 2%), cntrl.Height)

            Case AnchorPoint.BottomRight
               ret = New Size(0 + cntrl.Width, cntrl.Height)

         End Select 'PositionOnControlAnchor  

      Return ret
   End Function


   Private Sub TBEnter(ByVal sender As Object, ByVal e As EventArgs)
      ShowCaret(CType(sender, Control).Handle)
   End Sub

   Private Sub TBLeave(ByVal sender As Object, ByVal e As EventArgs)
      HideCaret(CType(sender, Control).Handle)
   End Sub

   <Runtime.InteropServices.DllImport("user32.dll")> _
   Private Function ShowCaret(ByVal hWnd As IntPtr) As Boolean
   End Function

   <Runtime.InteropServices.DllImport("user32")> _
   Private Function HideCaret(ByVal hWnd As IntPtr) As Integer
   End Function
End Module